﻿'这里是所有控件源码的公共部分

Type clsControl '控件类
   nHwnd            As hWnd   '句柄
   IDC              As Long   '本控件的IDC 号 从 1001 开始，每创建1个控件就 +1
   nName            As String '控件名称，代码中使用
   Caption          As String '窗口文字 utf8编码
   Font             As String '字体，Utf8 格式 ，控件中绘制文本的字体，格式为：字体,字号,加粗,斜体,下划线,删除线  中间用英文豆号分割，可以省略参数 默认为：宋体,9,0,0,0,0  自动响应系统DPI创建字体大小。
   ControlName      As String '控件类型名称
   IsTab            As Long   '是不是允许使用Tab
   Index            As Long = -1 '控件数组索引，小于零表示非控件数组
   nLeft            As Long
   nTop             As Long
   nWidth           As Long
   nHeight          As Long
   ForeColor        As Long = &H197F7F7F '保存颜色值，事件里用，需要用 GetCodeColorGDI 或 GetCodeColorGDIplue 转为 GDI 和 GDI+ 颜色值
   BackColor        As Long = &H197F7F7F '保存颜色值，事件里用，需要用 GetCodeColorGDI 或 GetCodeColorGDIplue 转为 GDI 和 GDI+ 颜色值
   Style            As UInteger '     '样式，主要用于虚拟控件，各个控件定义不同
   cTi              As Long    '控件对应 控件工具箱索引
   PVALUE(1 To 100) As String  '控件属性属性值 utf8编码，为了支持大字符
   IsSelected       As Long    '是不是被多选中，副的选中
   CtlData(99)      As Integer '为每个控件提供 100 个数据储存(编写控件使用，控件根据自己需要存放任意数据)。
   
End Type
Type ColProType '控件属性类
   sName   As String '属性英文名称
   uName   As String '名称，大写，用来不区分大小写对比查找
   zName   As CWSTR  '属性中文名称
   sHelp   As CWSTR  '帮助文档
   Default As CWSTR  '默认值 ，新建控件用
   AllList As CWSTR  '所有值，提供选择
   nType   As Long   '类型，0：数字 1：文本 2：选择 3：颜色 4：字体 5：图像 6：图标  7：选择图像控件  8-99 保留以后用  100-???，由DLL负责处理
End Type
Type ColEventType '控件事件
   sName As String '事件英文名称
   uName As String '名称，大写，用来不区分大小写对比查找
   Param As String '参数表，带前后 () 和返回类型
   sHelp As CWSTR  '注解或帮助文档
   tMsg  As String '消息值（在控件DLL中识辨处理用）在 CODE_FORM 模板中要替换的目标 {目标}
   gCall As String '调用事件代码，要代替的代码，其中 {$1} 是事件合成名称，必须由IDE合成后替换
   nNew  As CWSTR  '新建事件时插入的代码
End Type
Type ColToolType '控件工具
   sName                     As String       '名称，大小写
   uName                     As String       '名称，大写，用来不区分大小写对比查找
   sTips                     As String       '鼠标提示，在控件显示区提示用
   Folder                    As String       '控件配置文件夹名，不带路径。路径固定为：app.path + Languages\语言\Control
   ClassFile                 As String       '控件类文件名，在 Folder 文件夹里的类声明文件名
   ProLib                    As String       '处理编译和编辑的DLL文件名，在 Folder 文件夹里
   group                     As String       '分组
   sVale                     As Long         '字体图标值，在控件显示区显示用
   sIco                      As HICON        '图标句柄，有图标时显示图标，不显示字体图标。
   Feature                   As Long         '特征 =0 不使用 =1 主窗口 =2 普通控件  =3 虚拟控件有界面 =4 虚拟控件无界面
   Only                      As Long         '是否是唯一的，就是一个窗口只能有1个此控件
   ProList(1 To 100)         As ColProType   '最多100个属性
   plU                       As Long         '属性个数
   EveList(1 To 100)         As ColEventType '最多100个事件
   elU                       As Long         '事件个数
   library                   As Any Ptr      '处理 DLL 模块地址
   initialization            As Any Ptr
   SetControlProperty        As Any Ptr ' 设置控件工具属性
   Edit_ControlPropertyAlter As Any Ptr
   Edit_AddControls          As Any Ptr
   Edit_SetControlProperty   As Any Ptr
   Edit_OnPaint              As Any Ptr
   Compile_ExplainControl    As Any Ptr
   Edit_SetControlEvent      As Any Ptr
End Type


Type StyleFormType
   hWndForm As hWnd
   hWndList As hWnd
   nType    As Long
   value    As String Ptr
   default  As String Ptr
   AllList  As String Ptr
   Rvalue   As String '返回值
   nName    As String '当前控件名 A字符
   FomName  As String '当前窗口名 A字符
End Type
Type pezi '配置
   fw                   As Long     '功能区宽度
   fh                   As Long     '提示区高度
   fg                   As Long     '代码窗口在那边 0：在左边 1：在右边
   Move_p               As Long     '拖动分割线 0：没 1：左右 2：上下
   DefaultProjectPath   As String   '默认工程文件夹
   MultipleInstances    As Long     '   允许开多个VisualFreeBasic
   SaveProjectOnExit    As Long     '退出VisualFreeBasic 自动保存文件
   AutoSave             As Long     '自动保存（每1分钟保存1次）
   AutoSaveTime         As UInteger ' 自动保存时间 =timeGetTime
   AutoToFiles          As Long     '自动关联文件（*.ffp;*.bas）
   CheckMirror          As Long     '使用镜像（每次编译时复制工程到下面文件夹里）
   MirrorFolder(2)      As String   ' 镜像文件夹
   AutoBackup           As Long     '自动备份（敲键盘100下将产生备份文件，保存7天）
   BackupFolder         As String   ' 自动备份文件夹
   StartupPage          As Long     ' 启动VisualFreeBasic后
   SyntaxHighlighting   As Long     '语法突出显示
   Codetips             As Long     '代码提示
   AutoComplete         As Long     '自动完成
   ConfineCaret         As Long     '限制插入符号
   HighlightCurrentLine As Long     '突出显示当前行
   TabIndentSpaces      As Long     '制表符缩进空格
   AutoIndentation      As Long     '自动缩进
   AllowVfbLibrary      As Long     '允许修改 VFB 库文件
   FoldMargin           As Long     '显示折叠区
   LineNumbering        As Long     '显示行编号
   IndentGuides         As Long     '显示缩进参考线
   RightEdge            As Long     '行字符右边界线
   RightEdgePosition    As Long     '右边界线位置
   TabSize              As Long     'TAB空格字符数
   EditorFontname       As String   '编辑字体名称
   EditorFontCharSet    As String   '编辑字体字符集
   EditorFontsize       As Long     '编辑器字体大小
   KeywordCase          As Long     ' "Original Case"  '关键字大小写
   FBWINCompiler32      As String   '32位编译器
   FBWINCompiler64      As String   '64位编译器
   CompilerSwitches     As String   '编译器附加选项
   HideCompileResults   As Long     '如果在编译过程中没有发生错误则不提示编译结果
   MinimizeOnCompile    As Long     '运行已编译的程序时最小化 VisualFreeBasic
   ChineseCodeToEnglish As Long     '中文代码转换为英文（适合不支持中文代码的编译器）
   FBKeywords           As String   'FB关键词，从   .\Settings\freebasic_keywords.txt  读取
   APIKeywords          As String   'API关键词，从   .\Settings\freebasic_keywords.txt  读取
   LibKeywords          As String   '函数库关键词，自动提取
   FBKeywordsC          As String   'FB关键词，小写，火花编辑器必须提供小写
   APIKeywordsC         As String   'API关键词
   LibKeywordsC         As String   '函数库关键词
   SuppressNotify       As BOOLEAN  ' 暂时禁止Scintilla事件
   WinProChin           As Long     '窗口属性名显示中文
   WinFont              As String   '窗口控件默认字体
   Languages            As String   '多国语言文件夹
   TitleBarPath         As Long     '标题栏显示工程文件路径
   TitleBarVFB          As Long     '标题栏显示VFB版本号
   ShowSpaces           As Long     '可以使空白可见  0=正常模式不显示  1=点和箭头 2=缩进后的点和箭头 3=缩进点和箭头
   FunStart             As Long     '显示函数开始行底色
   FunEnd               As Long     '显示函数结束分隔线
   FuZhuCe              As Long     '不显示侧边栏， =0显示，<>0不显示 ，默认显示，也不保存。
   FuZhuDb              As Long     '不显示底边栏， =0显示，<>0不显示 ，默认显示，也不保存。
End Type

Dim Shared GetWinFontLog           As Function(mFont As String) As HFONT '有没有存在样式，需要全部都没有才成立，返回非0，
Dim Shared IsEventComparison       As Function(Control As clsControl ,ColTool As ColToolType ,ii As Long ,ff As Long ,nFile As String ,aa As String ,Form_clName As String) As Long '判断事件是不是正确，返回非0，
Dim Shared SetTextStyleVale        As Sub(Control As clsControl ,ColTool As ColToolType ,ki As Long ,i As Long ,vv As String ,tTy As String) '修改文本样式值
Dim Shared GetColToolProIndex      As Function(ColTool As ColToolType ,proName As String) As Long '获取控件工具箱上属性名称对应的索引
Dim Shared GetColorText            As Function(nText As String)                      As Long      '样式符合，转换为颜色值,系统色为 SYS,1
Dim Shared IsStyleAllON            As Function(AllStyle As String ,cStyle As String) As Long      '有没有存在样式，需要全部都有才成立，返回非0，
Dim Shared IsStyleAllOFF           As Function(AllStyle As String ,cStyle As String) As Long      '有没有存在样式，需要全部都没有才成立，返回非0，
Dim Shared GetStyleValeOR          As Function(sNameOR As String ,EX As Long)        As UInteger  '获取所有样式值组合,EX=0 所有 =1 扩展 =2非扩展
Dim Shared ExplainControlPublic    As Function(Form_clName As String ,Control As clsControl ,clName As String ,ii As Long ,uName As String ,clType As Long ,clStyle As String ,clExStyle As String ,clPro As String ,ProWinCode As String) As Long '处理公共部分，已处理返回0，未处理返回非0
Dim Shared GetOpAPP                As Function() As Any Ptr '获取VFB 的 配置指针 ，使用函数必须带() 不然就是本函数指针，如 Dim vfbOp As pezi Ptr = GetOpAPP()
Dim Shared GetExeAPP               As Function() As Any Ptr '获取EXE 的 APP指针
Dim Shared GetProRunFileEx         As Function(p As Long ,n As Long ,r As ZString Ptr)          As Long '{2.0 带输出路径+输出文件.1 输出路径.2 输出文件（不带路径）.3 工程文件.4 工程文件夹.5 工程名称}
Dim Shared GetImgFormEx            As Function(yName As String ,nImg As Long ,r As ZString Ptr) As Long
Dim Shared CheckIfTheControlExists As Function(nName As String ,ToolName As String)             As Long
Dim Shared OpenHelp                As Sub(nHelp As String)
Dim Shared OpenColorDialog         As Function(cHwnd As hWnd ,nColor As Long) As Long
Dim Shared GetMainWinHandle        As Function()                  As HWND
Dim Shared IsMultiLanguage         As Function()                  As Long '当前工程是不是启用多国语言
Dim Shared CurProIsChildWindow     As Function(chuanko As String) As Long '当前工程中，窗口是不是存在以及是不是子窗口属性。
Dim Shared CurProSetChildWindow    As Sub(hWndForm As hWnd) '当前工程中，让主窗口填充子窗口属性的窗口。
Dim Shared FileToResourceName      As Function(nFile As String ,p As Long = 0) As ZString Ptr '把文件名转换为资源名（当前工程） ，文件名不带路径，纯名称，为了导出给DLL使用，不可返回 String ，会发生时不时的崩溃

'函数声明

Sub SetFunctionAddress() '设置函数地址
   Dim library As Any Ptr = GetModuleHandle(null) 'EXE 模块句柄
   GetWinFontLog           = DyLibSymbol(library ,"GETWINFONTLOG")           '有没有存在样式，需要全部都没有才成立，返回非0，
   IsEventComparison       = DyLibSymbol(library ,"ISEVENTCOMPARISON")       '判断事件是不是正确，返回非0，
   SetTextStyleVale        = DyLibSymbol(library ,"SETTEXTSTYLEVALEEX")      '修改文本样式值
   GetColToolProIndex      = DyLibSymbol(library ,"GETCOLTOOLPROINDEXEX")    '获取控件工具箱上属性名称对应的索引
   GetColorText            = DyLibSymbol(library ,"GETCOLORTEXT")            '样式符合，转换为颜色值,系统色为 SYS,1
   IsStyleAllON            = DyLibSymbol(library ,"ISSTYLEALLON")            '有没有存在样式，需要全部都有才成立，返回非0，
   IsStyleAllOFF           = DyLibSymbol(library ,"ISSTYLEALLOFF")           '有没有存在样式，需要全部都没有才成立，返回非0，
   GetStyleValeOR          = DyLibSymbol(library ,"GETSTYLEVALEOR")          '获取所有样式值组合,EX=0 所有 =1 扩展 =2非扩展
   ExplainControlPublic    = DyLibSymbol(library ,"EXPLAINCONTROLPUBLIC")    ''处理公共部分，已处理返回0，未处理返回非0
   GetOpAPP                = DyLibSymbol(library ,"GETOPAPP")                '获取VFB 的 配置指针
   GetExeAPP               = DyLibSymbol(library ,"GETEXEAPP")               '获取EXE 的 APP指针
   GetProRunFileEx         = DyLibSymbol(library ,"GETPRORUNFILEEX")         '得到工程编译的文件名,p=0为当前工程{2.0 带输出路径+输出文件.1 输出路径.2 输出文件（不带路径）.3 工程文件 .4 工程文件夹}
   GetImgFormEx            = DyLibSymbol(library ,"GETIMGFORMEX")            '打开图像管理器，获取图像文件名称,yName=原名 nImg=0 任意图像 =1 ICO图标
   CheckIfTheControlExists = DyLibSymbol(library ,"CHECKIFTHECONTROLEXISTS") '检查控件是不是存在，不存在返回0 ，存在返回非0
   OpenHelp                = DyLibSymbol(library ,"OPENHELP")                '只能指定帮助文件下的帮助文档
   OpenColorDialog         = DyLibSymbol(library ,"OPENCOLORDIALOG")         ' 打开色彩对话框，GDI 颜色值
   GetMainWinHandle        = DyLibSymbol(library ,"GETMAINWINHANDLE")        '获取EXE主窗口句柄
   IsMultiLanguage         = DyLibSymbol(library ,"ISMULTILANGUAGE")         '当前工程是不是启用多国语言
   CurProIsChildWindow     = DyLibSymbol(library ,"CURPROISCHILDWINDOW")     '当前工程中，窗口是不是存在以及是不是子窗口属性。
   CurProSetChildWindow    = DyLibSymbol(library ,"CURPROSETCHILDWINDOW")    '当前工程中，让主窗口填充子窗口属性的窗口。
   FileToResourceName      = DyLibSymbol(library ,"FILETORESOURCENAME")
   
End Sub

Function TextAddWindowStyle(ByVal tStyle As String, aStyle As String) As String '给文本样式列表中增加样式。
   If Len(tStyle) = 0 Then Return aStyle
   Dim sStyle As String = "," & YF_Replace(tStyle, " ", "") & ","
   sStyle = YF_Replace(sStyle ,"," & aStyle & "," ,",") & aStyle & ","
   Function = Trim(sStyle, ",")
End Function
Function TextRemoveWindowStyle(ByVal tStyle As String, rStyle As String) As String '移除文本样式列表中的样式
   If Len(tStyle) = 0 Then Return ""
   Dim sStyle As String = "," & YF_Replace(tStyle, " ", "") & ","
   sStyle = YF_Replace(sStyle, "," & rStyle & ",", ",")
   Function = Trim(sStyle, ",")
   
End Function

Function GetStyleOR(sNameOR As String, EX As Long = 0) As String  '获取所有样式值组合,EX=0 所有 =1 扩展 =2非扩展
   Dim syt() As String
   Dim u As Long = vbSplit(sNameOR, ",", syt()), aa As String
   If u = -1 Then Return "0"
   For i As Long = 0 To u -1
      If EX > 0 Then
         If InStr(syt(i), "_EX_") > 0 Then
            If EX = 2 Then Continue For
         Else
            If EX = 1 Then Continue For
         End If
      End If
      If Len(aa) = 0 Then
         aa = syt(i)
      Else
         aa &= " Or " & syt(i)
      End If
   Next
   if Len(aa) = 0 Then aa = "0"
   Function = aa
End Function
Function GetColorTextCode(nText As String) As String  '转换字符样式为代码
   Dim cs As String = Trim(nText)
   Dim f  As Long
   If Left(cs ,3) = "SYS" Then
      f = InStr(cs ,",")
      If f > 0 Then cs = Mid(cs ,f + 1)
      f = ValInt(cs)
      Return "GetSysColor(" & f & ")"
   Else
      f = InStr(cs ,"'")
      If f > 0 Then cs = Left(cs ,f - 1)
      Return cs
   End If
End Function
Function GetProRunFile(p As Long ,a As Long ) As String  
   Dim r As zString * 260
   GetProRunFileEx(p, a, @r)
   Function = r 
End Function
Sub Insert_code(ProWinCode As String, mark As String, InCode As String,Eline As Long =0) Export '插入代码
   'ProWinCode   模板代码
   'mark         标记，区分大小写，标记应该是唯一的。
   'InCode       插入的代码
   'Eline        是否在标记下一行插入
   Dim ff As Long
   Do
      ff = InStr(ff + 1, ProWinCode, mark)
      if ff = 0 Then Exit Do
      if Mid(ProWinCode, ff -1, 1) <> """" Then  '预防抓错，抓到非标记
         if Eline Then 
            ff = InStr(ff + 1, ProWinCode, vbCrLf)
            ProWinCode = Left(ProWinCode, ff +1) & InCode & Mid(ProWinCode, ff)
         Else 
            ProWinCode = Left(ProWinCode, ff -1) & InCode & vbCrLf & Mid(ProWinCode, ff)
         End if 
         Exit Do
      End if
   Loop
End Sub
Function GetTextFileStr(szFileName As CWSTR) As String '从文件读取文本，自动识别编码，统一返回 Utf8格式
   Dim hFile As HANDLE = CreateFileW(szFileName, GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL)
   Dim r As Long 
   if hFile = INVALID_HANDLE_VALUE Then r = 1
   Dim bErrorFlag As WINBOOL, nFileSize As UInteger, txt As String
   if r = 0 Then 
      if GetFileSizeEx(hFile, Cast(Any Ptr,@nFileSize)) = 0 Then r = 1
   End if 
   if r=0 And nFileSize>0 Then 
      txt =String(nFileSize,0) 
      bErrorFlag = ReadFile(hFile, StrPtr(txt), Len(txt), @nFileSize, NULL)
      if bErrorFlag = FALSE Then r = 1
   End if 
   CloseHandle(hFile)   
   
   if r=0 Then    
      '什么头都没有直接数据的就是ANSI类型,
      'EF BB BF头的就是UTF-8类型,
      'FF FE头的就是UNICODE类型的,
      'FE FF头的就是UNICODE BIG ENDIAN类型的
      If Len(txt) > 2 AndAlso txt[0] = &HEF AndAlso txt[1] = &HBB AndAlso txt[2] = &HBF Then
         txt = Mid(txt ,4)
      elseIf Len(txt) > 1 AndAlso txt[0] = &HFF AndAlso txt[1] = &HFE Then
         txt = wStrToUtf8(Cast(Any Ptr ,Cast(UInteger ,StrPtr(txt)) + 2) ,Len(txt) / 2 -1)
      Else
         txt = StrToUtf8(txt)
      End If
      '替换 Chr(9) 为空格 ,避免代码分析软件出错
      if Len(txt) > 0 Then 
         for i As Long = 0 To Len(txt) -1
            if txt[i] = 9 Then txt[i] = 32
         Next 
      end if   
      if InStr(txt ,vbCrLf) = 0 Then txt = YF_Replace(txt ,vblf ,vbCrLf) '会遇到几个特殊的
      
      Function = txt      
   End If
End Function

Function GetImgForm(yName As String, nImg As Long) As String  
   Dim r As ZString *260
   GetImgFormEx(yName, nImg, @r)
   Function = r  
End Function

Function AttributeOREvent(ColTool As ColToolType ,language As Long) As Long '从配置文件中读取属性和事件， 成功返回0 失败非0，失败后VFB退出。
   'language <>0支持多国语言，会去VFB主语言文件里读取语言，修改配置里的文字。
   '当控件DLL文件夹里 无 Languages.txt 文件时，会自动产生原文 Languages.txt  ，然后把内容添加到VFB主语言文件里，实现多国语言。
   '注意：当修改过配置后，删除 Languages.txt 运行1次VFB 重新生成原文，然后去替换 VFB主语言文件。
   
   Dim pp As CWSTR = App.Path & "Attribute.ini" '控件属性配置  =====================================
   If AfxFileExists(pp) = 0 Then
      MsgBox(0 ,vfb_LangString("控件属性配置文件丢失！") & vbCrLf & pp , _
         MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_SYSTEMMODAL Or MB_SETFOREGROUND Or MB_TOPMOST)
      Return 1
   End If
   Dim bb() As String ,uu As Long
   Dim txtP As String = GetTextFileStr(pp) '处理速度 A文本总是比W文本快，转为 UTF8处理，来支持大字符集（火星文）
   If Len(txtP) = 0 Then
      MsgBox(0 ,vfb_LangString("控件属性配置无法读取！") & vbCrLf & pp , _
         MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_SYSTEMMODAL Or MB_SETFOREGROUND Or MB_TOPMOST)
      Return 11
   End If
   uu = vbSplit(txtP ,vbCrLf ,bb())
   Dim ii As Long ,ai As Long ,ubb As String
   For ii = 0 To uu -1
      ubb = Trim(bb(ii))
      If Left(ubb ,1) = "[" AndAlso Right(ubb ,1) = "]" Then '控件属性的名称
         ai                        += 1
         ColTool.ProList(ai).sName = Mid(ubb ,2 ,Len(ubb) -2)
         ColTool.ProList(ai).uName = UCase(ColTool.ProList(ai).sName)
         Continue For
      End if
      If ai > 0 And ai < 101 Then
         Dim ff As Long = InStr(ubb ,"=")
         if ff > 0 Then
            Dim jj As String = Trim(Mid(ubb ,ff + 1))
            Select Case UCase(Trim(Left(ubb ,ff -1)))
               Case "LOCALNAME" 'LocalName
                  ColTool.ProList(ai).zName = UTF8toCWSTR(jj)
               Case "TYPE"
                  ColTool.ProList(ai).nType = ValInt(jj)
               Case "HELP"
                  ColTool.ProList(ai).sHelp = UTF8toCWSTR(jj)
               Case "DEFAULT"
                  ColTool.ProList(ai).Default = UTF8toCWSTR(jj)
               Case "ALLLIST"
                  ColTool.ProList(ai).AllList = UTF8toCWSTR(jj)
            End Select
         End if
      End If
   Next
   If ai < 1 Or ai > 100 Then
      MsgBox(0 ,vfb_LangString("控件属性配置内容异常！") & vbCrLf & pp , _
         MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_SYSTEMMODAL Or MB_SETFOREGROUND Or MB_TOPMOST)
      Return 12
   End If
   
   ColTool.plU = ai
   
   pp = App.Path & "Event.ini" '控件事件配置 ==================================================
   If AfxFileExists(pp) = 0 Then
      MsgBox(0 ,vfb_LangString("控件事件配置文件丢失！") & vbCrLf & pp , _
         MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_SYSTEMMODAL Or MB_SETFOREGROUND Or MB_TOPMOST)
      Return 2
   End If
   txtP = GetTextFileStr(pp) '处理速度 A文本总是比W文本快，转为 UTF8处理，来支持大字符集（火星文）
   If Len(txtP) = 0 Then
      MsgBox(0 ,vfb_LangString("控件事件配置无法读取！") & vbCrLf & pp , _
         MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_SYSTEMMODAL Or MB_SETFOREGROUND Or MB_TOPMOST)
      Return 21
   End If
   uu = vbSplit(txtP ,vbCrLf ,bb())
   Dim ei As Long
   for ii = 0 To uu -1
      ubb = Trim(bb(ii))
      if Left(ubb ,1) = "[" AndAlso Right(ubb ,1) = "]" Then '控件属性的名称
         ei                        += 1
         ColTool.EveList(ei).sName = Mid(ubb ,2 ,Len(ubb) -2)
         ColTool.EveList(ei).uName = UCase(ColTool.EveList(ei).sName)
         Continue for
      End If
      If ei > 0 And ei < 101 Then
         Dim ff As Long = InStr(ubb ,"=")
         if ff > 0 Then
            Dim jj As String = Trim(Mid(ubb ,ff + 1))
            Select Case UCase(Trim(Left(ubb ,ff -1)))
               Case "PARAM"
                  ColTool.EveList(ei).Param = jj
               Case "HELP"
                  ColTool.EveList(ei).sHelp = UTF8toCWSTR(jj)
               Case "MSG"
                  ColTool.EveList(ei).tMsg = jj
               Case "CALL"
                  ColTool.EveList(ei).gCall = jj
               Case "NEW"
                  ColTool.EveList(ei).nNew = ""
               Case Else
                  ff = 0
            End Select
         End If
         If ff = 0 Then
            If Len(ColTool.EveList(ei).nNew) = 0 Then
               If Len(bb(ii)) = 0 Then ColTool.EveList(ei).nNew = " " Else ColTool.EveList(ei).nNew = UTF8toCWSTR(bb(ii))
            Else
               ColTool.EveList(ei).nNew &= UTF8toCWSTR(vbCrLf & bb(ii))
            End If
         End If
      End If
   Next
   'If ei < 1 Or ei > 100 Then
   '   MsgBox(0 ,vfb_LangString("控件事件配置内容异常！") & vbCrLf & pp , _
   '      MB_OK Or MB_ICONERROR Or MB_DEFBUTTON1 Or MB_SYSTEMMODAL Or MB_SETFOREGROUND Or MB_TOPMOST)
   '   Return 22
   'End If
   ColTool.elU = ei '事件可以为 0
   
   '多国语言处理
   If language = 0 Then Return 0
   pp = App.Path & "Languages.txt" '语言文件
   If AfxFileExists(pp) = 0 Then
      '无语言文件就自己生成一个原文，然后需要编写者去替换 VFB 里的主语言文件，
      uu = ColTool.plU * 4 + ColTool.elU * 2
      ReDim bb(uu + 5) '为支持多国，字符用 utf8
      ei    = 0
      bb(0) = "Node=" & CWSTRtoUTF8(App.EXEName) & "_AttributeOREvent ' === " & CWSTRtoUTF8(vfb_LangString("这里是控件的属性和事件节点名"))
      bb(1) = "TotalText="
      bb(2) = "Part=Attribute  '==================== " & CWSTRtoUTF8(vfb_LangString("控件属性"))
      ai    = 2
      For ii = 1 To ColTool.plU '先提取 属性 -=================
         If Len(ColTool.ProList(ii).zName) Then '提取属性名
            ai += 1 : ei += 1
            If ai > UBound(bb) Then ReDim Preserve bb(ai + 100)
            bb(ai) = "txt_" & ei & "=" & CWSTRtoUTF8(ColTool.ProList(ii).zName) & vbCrLf & "out_" & ei & "="
         End If
         If Len(ColTool.ProList(ii).sHelp) Then '提取属性帮助
            ai += 1 : ei += 1
            If ai > UBound(bb) Then ReDim Preserve bb(ai + 100)
            bb(ai) = "txt_" & ei & "=" & CWSTRtoUTF8(ColTool.ProList(ii).sHelp) & vbCrLf & "out_" & ei & "="
         End If
         If Len(ColTool.ProList(ii).Default) Then '提取属性默认值
            Dim Default As String = CWSTRtoUTF8(ColTool.ProList(ii).Default)
            Dim ff      As Long   = InStr(Default ," - ") '只提取 选项 前面有 数字的，后面说明文字
            If ff Then
               Default = Mid(Default ,ff + 3)
               ai      += 1 : ei += 1
               If ai > UBound(bb) Then ReDim Preserve bb(ai + 100)
               bb(ai) = "txt_" & ei & "=" & Default & vbCrLf & "out_" & ei & "="
            End If
         End If
         If Len(ColTool.ProList(ii).AllList) Then
            Dim AllList As String = CWSTRtoUTF8(ColTool.ProList(ii).AllList)
            Dim ff      As Long   = InStr(AllList ," - ") '只提取 选项 前面有 数字的，后面说明文字
            If ff Then
               Dim allbb() As String
               vbSplit(AllList ,"," ,allbb())
               For i As Long = 0 To UBound(allbb)
                  ff = InStr(allbb(i) ," - ")
                  If ff Then
                     allbb(i) = Mid(allbb(i) ,ff + 3)
                     ai       += 1 : ei += 1
                     If ai > UBound(bb) Then ReDim Preserve bb(ai + 100)
                     bb(ai) = "txt_" & ei & "=" & allbb(i) & vbCrLf & "out_" & ei & "="
                  End If
               Next
            End If
         End If
      Next
      For ii = 1 To ColTool.elU '先提取 事件 -=================
         If Len(ColTool.EveList(ii).sHelp) Then
            ai += 1 : ei += 1
            If ai > UBound(bb) Then ReDim Preserve bb(ai + 100)
            bb(ai) = "txt_" & ei & "=" & CWSTRtoUTF8(ColTool.EveList(ii).sHelp) & vbCrLf & "out_" & ei & "="
         End If
         'If Len(ColTool.EveList(ii).nNew) Then   '插入的代码或注解，考虑到翻译的结果把代码乱改
         '   ai += 1 : ei += 1
         '   If ai > UBound(bb) Then ReDim Preserve bb(ai + 100)
         '   Dim nNew As String = CWSTRtoUTF8(ColTool.EveList(ii).nNew)
         '   bb(ai) = "txt_" & ei & "=" & YF_Replace(nNew ,vbCrLf ,"{CRLF}") & vbCrLf & "out_" & ei & "="
         'End If
      Next
      ReDim Preserve bb(ai)
      bb(1) &= ei
      SaveFileStr(pp ,Chr(&HFF ,&HFE) & Utf8toWStr(FF_Join(bb() ,vbCrLf)))
      
      
   Else
      Dim op       As pezi Ptr     = GetOpAPP()
      Dim ExeApp   As APP_TYPE Ptr = GetExeAPP()
      Dim langFile As CWSTR        = ExeApp->Path & "Languages\" & op->Languages & "\Languages.txt"
      txtP = GetTextFileStr(langFile) '处理速度 A文本总是比W文本快，转为 UTF8处理，来支持大字符集（火星文）
      If Len(txtP) = 0 Then Return False
      
      Dim i            As Long   ,f           As Long   ,uu    As Long ,ui As Long ,vi As Long
      Dim wlist()      As String ,yTxt        As String ,oText As String
      Dim node         As String ,nodeNameUtf As String = CWSTRtoUTF8(App.EXEName) & "_AttributeOREvent" ,nodeK As Long
      Dim u            As Long = vbSplit(txtP ,vbCrLf ,wlist())
      Dim LangString() As String
      For i = 0 To u -1
         If Left(wlist(i) ,5) = "Node=" Then ' ====== 读取节点
            f = InStr(wlist(i) ,"'")
            If f = 0 Then InStr(wlist(i) ," ")
            If f     Then node = Mid(wlist(i) ,6 ,f -6) Else node = Mid(wlist(i) ,6)
            node  = Trim(node)
            nodeK = nodeNameUtf = node
         Else
            If nodeK Then ' 自己节点才处理
               If uu = 0 Then
                  If Left(wlist(i) ,10) = "TotalText=" Then ' 预先获得数量来声明数组，这样执行效率高。
                     f = InStr(wlist(i) ,"'")
                     If f Then wlist(i) = Mid(wlist(i) ,11 ,f -11) Else wlist(i) = Mid(wlist(i) ,11)
                     uu = ValInt(wlist(i))
                     ReDim LangString(uu)
                  End If
               Else
                  Select Case Left(wlist(i) ,4)
                     Case "txt_"
                        f = InStr(wlist(i) ,"=")
                        If f Then
                           yTxt = Mid(wlist(i) ,f + 1) '先获取原文本，遇到没译文时就使用原文，这里不判断索引号，都是软件产生，永不出错，要遇到人为故意乱改就出错。
                        Else
                           yTxt = Mid(wlist(i) ,5) '这里永不会发生，除非人为乱改，属于容错处理
                        End If
                     Case "out_"
                        f = InStr(wlist(i) ,"=")
                        If f Then
                           oText = Mid(wlist(i) ,f + 1)
                           ui    = ValInt(Mid(wlist(i) ,5 ,f -5))
                        Else
                           ui    = 0 '这里永不会发生，除非人为乱改，属于容错处理
                           oText = Mid(wlist(i) ,5)
                        End If
                        If ui <= uu Then
                           If Len(oText) Then
                              LangString(ui) = YF_Replace(oText ,"{CRLF}" ,vbCrLf)
                           Else
                              LangString(ui) = YF_Replace(yTxt ,"{CRLF}" ,vbCrLf)
                           End If
                        End If
                        vi += 1
                  End Select
               End If
            End If
         End If
      Next
      If UBound(LangString) < 1 Then Return 0 '无语言就退出
      ai = 0
      For ii = 1 To ColTool.plU ' 属性 -=================
         If Len(ColTool.ProList(ii).zName) Then '提取属性名
            ai += 1
            If ai > UBound(LangString) Then Return 0 '无语言就退出
            ColTool.ProList(ii).zName = UTF8toCWSTR(LangString(ai))
         End If
         If Len(ColTool.ProList(ii).sHelp) Then '提取属性帮助
            ai += 1
            If ai > UBound(LangString) Then Return 0 '无语言就退出
            ColTool.ProList(ii).sHelp = UTF8toCWSTR(LangString(ai))
         End If
         If Len(ColTool.ProList(ii).Default) Then '提取属性默认值
            Dim Default As String = CWSTRtoUTF8(ColTool.ProList(ii).Default)
            Dim ff      As Long   = InStr(Default ," - ") '只提取 选项 前面有 数字的，后面说明文字
            If ff Then
               ai += 1
               If ai > UBound(LangString) Then Return 0 '无语言就退出
               ColTool.ProList(ii).Default = UTF8toCWSTR(Left(Default ,ff + 2) & LangString(ai))
            End If
         End If
         If Len(ColTool.ProList(ii).AllList) Then
            Dim AllList As String = CWSTRtoUTF8(ColTool.ProList(ii).AllList)
            Dim ff      As Long   = InStr(AllList ," - ") '只提取 选项 前面有 数字的，后面说明文字
            If ff Then
               Dim allbb() As String
               vbSplit(AllList ,"," ,allbb())
               For i As Long = 0 To UBound(allbb)
                  ff = InStr(allbb(i) ," - ")
                  If ff Then
                     ai += 1
                     If ai > UBound(LangString) Then Return 0 '无语言就退出
                     allbb(i) = Left(allbb(i) ,ff + 2) & LangString(ai)
                  End If
               Next
               ColTool.ProList(ii).AllList = UTF8toCWSTR(FF_Join(allbb() ,","))
            End If
         End If
      Next
      For ii = 1 To ColTool.elU ' 事件 -=================
         If Len(ColTool.EveList(ii).sHelp) Then
            ai += 1
            If ai > UBound(LangString) Then Return 0 '无语言就退出
            ColTool.EveList(ii).sHelp = UTF8toCWSTR(LangString(ai))
         End If
         'If Len(ColTool.EveList(ii).nNew) Then
         '   ai += 1
         '   If ai > UBound(LangString) Then Return 0 '无语言就退出
         '   ColTool.EveList(ii).nNew=UTF8toCWSTR(LangString(ai))
         'End If
      Next
   End If
   Function = 0
End Function

Function GetTextToOutText(nText As String) As String '文本转换为编译输出临时代码文本，可能是多国语言，转换为多国语言字符 ，字符是 UTF8
   Dim CaptionTxt As String = YF_Replace(nText ,Chr(34) ,Chr(34 ,34))
   If IsMultiLanguage() Then 'IsMultiLanguage 后面加()才表示使用函数，不然就是函数指针。
      CaptionTxt = YF_Replace(CaptionTxt ,Chr(3 ,1) ,""") & Chr(13,10) & vfb_LangString(""")
      CaptionTxt = "vfb_LangString(""" & CaptionTxt & """)"
   Else
      CaptionTxt = """" & YF_Replace(CaptionTxt ,Chr(3 ,1) ,""" & vbCrLf & """) & """"
   End If
   Function = CaptionTxt
End Function














